﻿Imports SlimDX
Imports SlimDX.Direct3D9

Public Class Model
    Implements IRenderable
    Dim Geometries() As StructureGeometries
    Dim Regions() As StructureRegions
    Dim Shaders() As IShader
    Dim SuperHighCutoff As Single
    Dim HighCutoff As Single
    Dim MediumCutoff As Single
    Dim LowCutoff As Single
    Dim SuperLowCutoff As Single

    Sub New(ByVal modeTag As Magic.Core.Tag)
        AddHandler modeTag.TagHasChanged, AddressOf changed
        Dim uScale As Single = modeTag("base map u-scale") '14
        Dim vScale As Single = modeTag("base map v-scale")

        SuperHighCutoff = modeTag("super-high detail cutoff:pixels")
        HighCutoff = modeTag("high detail cutoff:pixels")
        MediumCutoff = modeTag("medium detail cutoff:pixels")
        LowCutoff = modeTag("low detail cutoff:pixels")
        SuperLowCutoff = modeTag("super-low cutoff:pixels")

        Dim RegionBlock As Array = modeTag("regions")
        Dim RegionCount As Integer = RegionBlock.GetLength(0)
        ReDim Regions(RegionCount - 1)
        For x As Integer = 0 To RegionCount - 1
            Regions(x) = New StructureRegions(x, RegionBlock)
        Next

        Dim GeoBlock As Array = modeTag("geometries")
        Dim GeoCount As Integer = GeoBlock.GetLength(0)
        ReDim Geometries(GeoCount - 1)
        For x As Integer = 0 To GeoCount - 1
            Geometries(x) = New StructureGeometries(x, GeoBlock, uScale, vScale)
        Next

        Dim ShaderBlock As Array = modeTag("shaders")
        Dim ShaderCount As Integer = ShaderBlock.GetLength(0)
        ReDim Shaders(ShaderCount - 1)
        For x As Integer = 0 To ShaderCount - 1
            Dim sIndex As Integer = ShaderBlock.GetValue(x, 0)

            Shaders(x) = Managers.ReturnShader(sIndex)

        Next
    End Sub
    Sub changed(ByVal modeTag As Magic.Core.Tag)
        Dim uScale As Single = modeTag("base map u-scale") '14
        Dim vScale As Single = modeTag("base map v-scale")

        SuperHighCutoff = modeTag("super-high detail cutoff:pixels")
        HighCutoff = modeTag("high detail cutoff:pixels")
        MediumCutoff = modeTag("medium detail cutoff:pixels")
        LowCutoff = modeTag("low detail cutoff:pixels")
        SuperLowCutoff = modeTag("super-low cutoff:pixels")

        Dim RegionBlock As Array = modeTag("regions")
        Dim RegionCount As Integer = RegionBlock.GetLength(0)
        ReDim Regions(RegionCount - 1)
        For x As Integer = 0 To RegionCount - 1
            Regions(x) = New StructureRegions(x, RegionBlock)
        Next

        Dim GeoBlock As Array = modeTag("geometries")
        Dim GeoCount As Integer = GeoBlock.GetLength(0)
        ReDim Geometries(GeoCount - 1)
        For x As Integer = 0 To GeoCount - 1
            Geometries(x) = New StructureGeometries(x, GeoBlock, uScale, vScale)
        Next

        Dim ShaderBlock As Array = modeTag("shaders")
        Dim ShaderCount As Integer = ShaderBlock.GetLength(0)
        ReDim Shaders(ShaderCount - 1)
        For x As Integer = 0 To ShaderCount - 1
            Dim sIndex As Integer = ShaderBlock.GetValue(x, 0)

            Shaders(x) = Managers.ReturnShader(sIndex)

        Next
    End Sub
    Public Sub Render(ByVal xDevice As Device) Implements IRenderable.Render
        Dim p As Integer = 0
        Dim pTranslation As New Vector3(xDevice.GetTransform(TransformState.World).M41, xDevice.GetTransform(TransformState.World).M42, xDevice.GetTransform(TransformState.World).M43)
        Dim cDistance As Single = Camera.vDistance(pTranslation)
        Dim detail As DetailLevel
        If cDistance <= HighCutoff Then
            detail = Model.DetailLevel.SuperHigh
        ElseIf cDistance > HighCutoff And cDistance <= MediumCutoff Then
            detail = Model.DetailLevel.High
        ElseIf cDistance > MediumCutoff And cDistance <= LowCutoff Then
            detail = Model.DetailLevel.Medium
        ElseIf cDistance > LowCutoff And cDistance <= SuperLowCutoff Then
            detail = Model.DetailLevel.Low
        ElseIf cDistance > SuperLowCutoff Then
            detail = Model.DetailLevel.SuperLow
        End If
        'For p As Integer = 0 To Regions(r).Permutations.Length - 1
        For r As Integer = 0 To Regions.Length - 1
            Dim dLevel As Short = Regions(r).Permutations(p).Details(detail)
            For x As Integer = 0 To Geometries(dLevel).Parts.Length - 1
                Dim bMax As Vector3 = Geometries(dLevel).Parts(x).bBox_Max
                'bMax = Vector3.TransformCoordinate(bMax, xDevice.Transform.World)
                'bMax = Vector3.Cross(bMax, pTranslation)
                bMax = Vector3.Add(bMax, pTranslation)
                Dim bMin As Vector3 = Geometries(dLevel).Parts(x).bBox_Min
                'bMin = Vector3.TransformCoordinate(bMin, xDevice.Transform.World)
                'bMin = Vector3.Cross(bMin, pTranslation)
                bMin = Vector3.Add(bMin, pTranslation)
                If BoxInFrustum(bMax, bMin) Then

                    If Geometries(dLevel).Parts(x).ShaderIndex <> -1 Then
                        Dim nShader As IShader = Shaders(Geometries(dLevel).Parts(x).ShaderIndex)
                        If Not nShader Is Nothing Then
                            Dim numpasses As Integer = nShader.BeginShader(Nothing)
                            For pass As Integer = 0 To numpasses - 1
                                nShader.BeginPass(pass)
                                Geometries(dLevel).Parts(x).lMesh.DrawSubset(0)
                                nShader.EndPass()
                            Next
                            nShader.EndShader()
                        Else
                            Geometries(dLevel).Parts(x).lMesh.DrawSubset(0)
                        End If
                    End If
                End If
            Next
            'Next
        Next
    End Sub
    Public Sub OccludeRender(ByVal xDevice As Device)
        Dim p As Integer = 0
        Dim pTranslation As New Vector3(xDevice.GetTransform(TransformState.World).M41, xDevice.GetTransform(TransformState.World).M42, xDevice.GetTransform(TransformState.World).M43)

        'For p As Integer = 0 To Regions(r).Permutations.Length - 1
        For r As Integer = 0 To Regions.Length - 1
            Dim dLevel As Short = Regions(r).Permutations(p).Details(Model.DetailLevel.SuperLow)
            For x As Integer = 0 To Geometries(dLevel).Parts.Length - 1

                Dim bMax As Vector3 = Geometries(dLevel).Parts(x).bBox_Max
                bMax = Vector3.Add(bMax, pTranslation)

                Dim bMin As Vector3 = Geometries(dLevel).Parts(x).bBox_Min
                bMin = Vector3.Add(bMin, pTranslation)

                If BoxInFrustum(bMax, bMin) Then
                    'If Geometries(dLevel).Parts(x).ShaderIndex <> -1 Then
                    'Dim nShader As IShader = Shaders(Geometries(dLevel).Parts(x).ShaderIndex)
                    'If Not nShader Is Nothing Then
                    'If nShader.GetType Is GetType(ShaderModel) Then
                    Geometries(dLevel).Parts(x).lMesh.DrawSubset(0)
                    'End If
                    'End If
                    'End If
                End If
            Next
            'Next
        Next
    End Sub
    Public Sub RenderNoCull(ByVal xDevice As Device)
        Dim p As Integer = 0

        Dim detail As DetailLevel

        detail = Model.DetailLevel.SuperLow

        'For p As Integer = 0 To Regions(r).Permutations.Length - 1
        For r As Integer = Regions.Length - 1 To 0 Step -1
            Dim dLevel As Short = Regions(r).Permutations(p).Details(detail)
            For x As Integer = Geometries(dLevel).Parts.Length - 1 To 0 Step -1


                If Geometries(dLevel).Parts(x).ShaderIndex <> -1 Then
                    Dim nShader As IShader = Shaders(Geometries(dLevel).Parts(x).ShaderIndex)
                    If Not nShader Is Nothing Then
                        Dim numpasses As Integer = nShader.BeginShader(Nothing)
                        For pass As Integer = 0 To numpasses - 1
                            nShader.BeginPass(pass)
                            Geometries(dLevel).Parts(x).lMesh.DrawSubset(0)
                            nShader.EndPass()
                        Next
                        nShader.EndShader()
                    Else
                        Geometries(dLevel).Parts(x).lMesh.DrawSubset(0)
                    End If
                End If
            Next
            'Next
        Next
    End Sub
    Sub Dispose()
        For dlevel As Integer = 0 To Geometries.Length - 1
            For x As Integer = 0 To Geometries(dlevel).Parts.Length - 1
                If Geometries(dlevel).Parts(x).ShaderIndex <> -1 Then
                    '  Shaders(Geometries(dlevel).Parts(x).ShaderIndex).Dispose()
                End If
                Geometries(dlevel).Parts(x).lMesh.Dispose()
            Next
        Next
    End Sub
    Function Intercept(ByVal nRay As Ray) As Single

        Dim closestDistance As Single = Single.MaxValue
        Dim currentDistance As Single = Single.MaxValue

        Dim p As Integer = 0
        For r As Integer = 0 To Regions.Length - 1
            'For p As Integer = 0 To Regions(r).Permutations.Length - 1

            Dim dLevel As Short = Regions(r).Permutations(p).Details(DetailLevel.SuperHigh)
            For x As Integer = 0 To Geometries(dLevel).Parts.Length - 1
                If Geometries(dLevel).Parts(x).ShaderIndex <> -1 Then
                    If Geometries(dLevel).Parts(x).lMesh.Intersects(nRay, currentDistance) Then
                        If currentDistance < closestDistance Then
                            closestDistance = currentDistance
                        End If
                    End If
                End If
            Next
            'Next
        Next

        Return closestDistance
    End Function
    Public Enum DetailLevel
        SuperLow = 0
        Low = 1
        Medium = 2
        High = 3
        SuperHigh = 4
    End Enum
    Public Class StructureGeometries
        Public Parts() As StructureParts
        Sub New(ByVal index As Integer, ByVal tagArray As Array, ByVal uScale As Single, ByVal vScale As Single)
            Dim PartBlock As Array = tagArray.GetValue(index, 2)
            Dim PartCount As Integer = PartBlock.GetLength(0)
            ReDim Parts(PartCount - 1)
            For x As Integer = 0 To PartCount - 1
                Parts(x) = New StructureParts(x, PartBlock, uScale, vScale)
            Next
        End Sub

        Public Class StructureParts
            Public ShaderIndex As Integer
            Dim Surfaces() As Short
            Dim Verts() As PositionTexture
            Public lMesh As Mesh
            Public bBox_Min, bBox_Max As Vector3
            Sub New(ByVal index As Integer, ByVal tagArray As Array, ByVal uScale As Single, ByVal vScale As Single)
                ShaderIndex = tagArray(index, 1)
                '9 Uncompressed Verts
                '10 Compressed Verts

                '11 triangles
                Dim SurfaceBlock As Array = tagArray.GetValue(index, 11)
                Dim SurfaceCount As Integer = SurfaceBlock.GetLength(0)

                Dim tSurfaces(SurfaceCount * 3 - 1) As Short
                For x As Integer = 0 To SurfaceCount - 1
                    tSurfaces(x * 3) = SurfaceBlock.GetValue(x, 0)
                    tSurfaces(x * 3 + 1) = SurfaceBlock.GetValue(x, 1)
                    tSurfaces(x * 3 + 2) = SurfaceBlock.GetValue(x, 2)
                Next
                Dim NegIndex As Integer = Array.IndexOf(tSurfaces, -1S)
                If NegIndex = -1 Then NegIndex = tSurfaces.Count
                If NegIndex < 2 Then NegIndex = tSurfaces.Count
                Dim sArray As New ArrayList
                Dim tempIndice As Integer = 0
                For z As Integer = 2 To NegIndex - 1

                    Dim Indice(2) As Short
                    Indice(0) = tSurfaces(z - 2)

                    If (z Mod 2) = 0 Then
                        Indice(1) = tSurfaces(z - 1)
                        Indice(2) = tSurfaces(z)
                    Else
                        Indice(1) = tSurfaces(z)
                        Indice(2) = tSurfaces(z - 1)
                    End If

                    If Not (Indice(0) = Indice(1) Or Indice(1) = Indice(2) Or Indice(2) = Indice(0)) Then
                        If Indice(0) <> -1 Or Indice(1) <> -1 Or Indice(2) <> -1 Then
                            sArray.AddRange(Indice)
                        End If
                    End If
                Next
                Surfaces = sArray.ToArray(GetType(Short))

                Dim VerticeBlock As Array = tagArray(index, 10)
                Dim VerticeCount As Integer = VerticeBlock.GetLength(0)
                ReDim Verts(VerticeCount - 1)
                For z As Integer = 0 To VerticeCount - 1
                    Dim nVert As New PositionTexture
                    nVert.X = VerticeBlock.GetValue(z, 0)(0)
                    nVert.Y = VerticeBlock.GetValue(z, 0)(1)
                    nVert.Z = VerticeBlock.GetValue(z, 0)(2)

                    If nVert.X > bBox_Max.X Then
                        bBox_Max.X = nVert.X
                    End If
                    If nVert.Y > bBox_Max.Y Then
                        bBox_Max.Y = nVert.Y
                    End If
                    If nVert.Z > bBox_Max.Z Then
                        bBox_Max.Z = nVert.Z
                    End If

                    If nVert.X < bBox_Min.X Then
                        bBox_Min.X = nVert.X
                    End If
                    If nVert.Y < bBox_Min.Y Then
                        bBox_Min.Y = nVert.Y
                    End If
                    If nVert.Z < bBox_Min.Z Then
                        bBox_Min.Z = nVert.Z
                    End If

                    Dim Normals() As Single = Decompress(VerticeBlock.GetValue(z, 1))
                    nVert.nX = Normals(0)
                    nVert.nY = Normals(1)
                    nVert.nZ = Normals(2)

                    Dim BiNormals() As Single = Decompress(VerticeBlock.GetValue(z, 2))
                    nVert.bX = BiNormals(0)
                    nVert.bY = BiNormals(1)
                    nVert.bZ = BiNormals(2)

                    Dim Tangent() As Single = Decompress(VerticeBlock.GetValue(z, 3))
                    nVert.tX = Tangent(0)
                    nVert.tY = Tangent(1)
                    nVert.tZ = Tangent(2)

                    nVert.u1 = DecompressShortToFloat(VerticeBlock.GetValue(z, 4)) * uScale
                    nVert.v1 = DecompressShortToFloat(VerticeBlock.GetValue(z, 5)) * vScale
                    Verts(z) = nVert
                Next
                CreateMesh()
            End Sub
            Sub CreateMesh()
                lMesh = New Mesh(xDevice, Surfaces.Length, Verts.Length, MeshFlags.Managed, PositionTexture.Format)
                Dim ds As DataStream = lMesh.LockVertexBuffer(LockFlags.None)
                ds.WriteRange(Verts)
                lMesh.UnlockVertexBuffer()
                ds = lMesh.LockIndexBuffer(LockFlags.None)
                ds.WriteRange(Surfaces)
                lMesh.UnlockIndexBuffer()


                ' lMesh.VertexBuffer.SetData(Verts, 0, LockFlags.None)
                ' lMesh.IndexBuffer.SetData(Surfaces, 0, LockFlags.None)

                ''Optimize Mesh
                'Dim pAdj(lMesh.NumberFaces * 3 - 1) As Integer
                'lMesh.GenerateAdjacency(0.0, pAdj)
                'lMesh.OptimizeInPlace(MeshFlags.OptimizeCompact Or MeshFlags.OptimizeAttributeSort Or MeshFlags.OptimizeVertexCache, pAdj)
                'pAdj = Nothing

                'Dim gData As DataStream = lMesh.LockVertexBuffer(LockFlags.ReadOnly)

                'Geometry.ComputeBoundingBox(gData, lMesh.VertexCount, PositionTexture.Format, bBox_Min, bBox_Max)
                ' lMesh.UnlockVertexBuffer()

                'Dim Temp(0) As Integer
                'Temp(0) = lMesh.NumberVertices
                'Verts = lMesh.LockVertexBuffer(GetType(PositionTexture), LockFlags.ReadOnly, Temp)
                'lMesh.UnlockVertexBuffer()
            End Sub
        End Class
    End Class
    Public Class StructureRegions
        Public Permutations() As StructurePermutations
        Sub New(ByVal index As Integer, ByVal tagArray As Array)
            Dim PermBlock As Array = tagArray.GetValue(index, 2)
            Dim PermCount As Integer = PermBlock.GetLength(0)
            ReDim Permutations(PermCount - 1)
            For x As Integer = 0 To PermCount - 1
                Permutations(x) = New StructurePermutations(x, PermBlock)
            Next
        End Sub
        Public Class StructurePermutations
            Public Details(4) As Short
            Sub New(ByVal index As Integer, ByVal tagArray As Array)
                For x As Integer = 0 To 4
                    Details(x) = tagArray.GetValue(index, 3 + x)
                Next
            End Sub
        End Class
    End Class
End Class
